home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / tclStruct1.2.tar.gz / tclStruct1.2.tar / tclStruct1.2 / ex / fsinfo.tcl < prev    next >
Text File  |  1995-10-17  |  5KB  |  173 lines
  1. #!/usr/local/bin/tclsh
  2. #    "@(#)tclStruct:fsinfo.tcl    1.1    95/10/17"
  3. #
  4. # Written by Matthew Costello
  5. # (c) 1995 AT&T Global Information Solutions, Dayton Ohio USA
  6. #
  7. # See the file "license.terms" for information on usage and
  8. # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9.  
  10. #    fsinfo.tcl [-server servername]
  11. # This is a (partial) implementation of the fsinfo(1) command:
  12. #    fsinfo is a utility for displaying information about an X
  13. #    font server.  It is used to examine the capabilities of a
  14. #    server, the predefined values for various parameters used in
  15. #    communicating between clients and the server, and the font
  16. #    catalogues and alternate servers that are available.
  17. #
  18.  
  19. # Load the required extensions
  20. load libdplite.so Tdp
  21. load libtclStruct.so Struct
  22.  
  23. # Determine where the font server is located
  24. catch {set fontserver $env(FONTSERVER)}
  25. if {[string compare [lindex $argv 0] "-server"] == 0} {
  26.     set fontserver [lindex $argv 1]
  27.     incr argc -2
  28. }
  29. if {$argc != 0} {
  30.     puts stderr "Usage: $argv0 \[-server servername\]"
  31.     exit 2
  32. }
  33. if {[catch {set fs [split $fontserver : ]}]} {
  34.     puts stderr "$argv0: FONTSERVER not set"
  35.     exit 2
  36. }
  37. if {[llength $fs] != 2} {
  38.     puts stderr "$argv0: FONTSERVER should have format 'server:port'"
  39.     exit 2
  40. }
  41.  
  42. # Connect to the font server
  43. #puts "name of server: $fontserver"
  44. set fd [eval dp_connect $fs]
  45. #puts "$argv0:  unable to open server "
  46. set fd [lindex $fd 0]
  47. puts "name of server: $fontserver"
  48.  
  49. # Font server data types
  50. struct_typedef request_packet {struct
  51.     {ubyte    major_opcode}
  52.     {ubyte    minor_opcode}
  53.     {ushort    length}
  54. }
  55. struct_typedef reply_packet {struct
  56.     {ubyte    type}
  57.     {ubyte    data}
  58.     {ushort    sequence}
  59.     {uint    length}
  60. }
  61.  
  62. set fs_statusSuccess    0
  63. set fs_statusContinue    1
  64. set fs_statusBusy    2
  65. set fs_statusDenied    3
  66.  
  67.  
  68. struct_typedef fs_open_connection_t {struct
  69.     align 1
  70.     {char    byte-order}
  71.     {ubyte    num-auths}
  72.     {ushort    client-major-protocol-version}
  73.     {ushort    client-minor-protocol-version}
  74.     {ushort    auth-len}
  75.     {ubyte*0    authorization-protocols}
  76.     align 4
  77. }
  78. struct_typedef fs_open_connection_setup_t {struct
  79.     {ushort    status}
  80.     {ushort    server-major-protocol-version}
  81.     {ushort server-minor-protocol-version}
  82.     {ubyte    num_alternates}
  83.     {ubyte    auth_index}
  84.     {ushort    alternate_len}
  85.     {ushort    auth_len}
  86.     {ubyte*0    data}
  87. }
  88. struct_typedef fs_open_connection_setup2_t {struct
  89.     {uint    remaining-length}
  90.     {ushort    maximum-request-length}
  91.     {ushort    vendor-length}
  92.     {uint    release-number}
  93.     {char*0    vendor}
  94. }
  95.  
  96. # Send the open connection request
  97. struct_new open_connection fs_open_connection_t(0)
  98. set open_connection() { l 0 2 0 }
  99. struct_write -unbuffered $fd open_connection
  100.  
  101.  
  102. struct_new connection_setup fs_open_connection_setup_t(0)
  103. set rlen [struct_read -unbuffered $fd connection_setup]
  104. puts "version number: $connection_setup(server-major-protocol-version)"
  105. if {$connection_setup(status) != 0} {
  106.     puts "$0: server did not accept connection ($connection_setup(status))"
  107.     exit 1
  108. }
  109.  
  110. struct_new connection_accept fs_open_connection_setup2_t(0)
  111. set rlen [struct_read -unbuffered $fd connection_accept]
  112.  
  113.  
  114. struct_typedef vendor_name1_t char*$connection_accept(vendor-length)
  115. struct_typedef vendor_name2_t {struct {vendor_name1_t vendor_name} align 4}
  116. struct_new vendor_name vendor_name2_t
  117. set rlen [struct_read -unbuffered $fd vendor_name]
  118. puts "vendor string:  $vendor_name(vendor_name)"
  119.  
  120. puts "vendor release number:  $connection_accept(release-number)"
  121. puts "maximum request size:   $connection_accept(maximum-request-length) longwords ([expr $connection_accept(maximum-request-length) * 4] bytes)"
  122.  
  123. # Request list of catalogs
  124. struct_typedef fs_list_catalogues_t {struct
  125.     {ubyte    major-opcode}
  126.     {ubyte    minor_opcode}
  127.     {ushort    length}
  128.     {uint    max-names}
  129.     {ushort    pattern-length}
  130.     {ushort {}}
  131.     {char*0 pattern}
  132.     align 4
  133. }
  134. struct_new list_catalogues fs_list_catalogues_t(1)
  135. set list_catalogues() {3 0 4 99999 1 "*"}
  136. set list_catalogues(length) [expr [struct_info sizeof list_catalogues] / 4]
  137. struct_write -unbuffered $fd list_catalogues
  138.  
  139. struct_typedef fs_list_catalogues_reply_t {struct
  140.     {ubyte    type}
  141.     {ubyte    pad}
  142.     {ushort    sequence-number}
  143.     {uint    length}
  144.     {uint    num-replies}
  145.     {uint    num-catalogues}
  146. }
  147.     # LISTofSTRNAME
  148. struct_new list_catalogues_reply fs_list_catalogues_reply_t
  149. set rlen [struct_read -unbuffered $fd list_catalogues_reply]
  150. #struct_dump list_catalogues_reply
  151. puts "number of catalogues:   $list_catalogues_reply(num-catalogues)"
  152.  
  153. struct_new buffer byte*200
  154. set rlen [struct_read -unbuffered $fd buffer [expr ( $list_catalogues_reply(length) - 4 ) * 4]]
  155. for {set i 0 ; set count $list_catalogues_reply(num-catalogues)} {$count > 0} {incr count -1} {
  156.     set len $buffer($i._ubyte_)
  157.     #puts "i = $i, len = $len"
  158.     incr i 1
  159.     puts "\t$buffer(_char_.$i-[expr $i + $len])"
  160.     incr i $len
  161. }
  162.  
  163.  
  164. puts "Number of alternate servers: $connection_setup(num_alternates)"
  165. # TODO: list the alternate servers
  166.  
  167. #puts "number of extensions:   $connection_setup(num_alternates)"
  168. # TODO: list the extensions
  169.  
  170.  
  171. # Close connection to server
  172. close $fd
  173.